home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 9 / FM Towns Free Software Collection 9.iso / t_os / tool / inryoku / inryoku.bas next >
BASIC Source File  |  1994-11-16  |  11KB  |  305 lines
  1. 10010 '--------------------------------------------------------------------
  2. 10020 '
  3. 10030 '    万有引力
  4. 10040 '
  5. 10050 '                                              Copyright (C) TeC 1994
  6. 10060 '--------------------------------------------------------------------
  7. 10070 SCREEN 0
  8. 10080 SCREEN@ 0
  9. 10090 'DIM SE01(5795),SE02(15634),SE03(14901),SE04(18819)               '**
  10. 10100 'DIM SE05(25573),SE06(24072),SE07(8348)                           '**
  11. 10110 'LOAD@"se_01.snd",SE01                                            '**
  12. 10120 'LOAD@"se_02.snd",SE02                                            '**
  13. 10130 'LOAD@"se_03.snd",SE03                                            '**
  14. 10140 'LOAD@"se_04.snd",SE04                                            '**
  15. 10150 'LOAD@"se_05.snd",SE05                                            '**
  16. 10160 'LOAD@"se_06.snd",SE06                                            '**
  17. 10170 'LOAD@"se_07.snd",SE07                                            '**
  18. 10180 SC=5
  19. 10190 *設定 '―――――――――――――――――――――――――――――――
  20. 10200 FOR I=1 TO 10
  21. 10210    PALETTE I,[0,255,255]
  22. 10220 NEXT I
  23. 10230 PALETTE 11,[63,63,63]
  24. 10240 WINDOW(0,479)-(639,0)
  25. 10250 DEF PEN 0,1
  26. 10260 CLS
  27. 10270 MOUSE 0
  28. 10280 MOUSE 2,CHR$(127,255,159,255,135,255,193,255,192,127,224,31,244,7,240,0,240,1,248,3,248,7,252,15,252,31,254,61,254,120,254,253),CHR$(128,0,96,0,120,0,62,0,47,128,23,224,19,248,9,255,8,254,4,124,4,56,2,16,2,32,1,66,1,135,1,2)
  29. 10290 MOUSE 4,0,0,639,479
  30. 10300 MOUSE 3,0,8 : MOUSE 3,1,8
  31. 10310 MOUSE 1,320,239,1
  32. 10320 DIM PX(10),PY(10),VX(10),VY(10),PW(10),A$(10)
  33. 10330 DIM PXD(10),PYD(10),PXS(10),PYS(10)
  34. 10340 N=0 : F=0 : C=0
  35. 10350 PC=1
  36. 10360 A$(0)="                sample  "
  37. 10370 A$(1)="    位置を決めてください"
  38. 10380 A$(2)="    速度を決めてください"
  39. 10390 A$(3)="質量の比を決めてください"
  40. 10400 A$(4)="      キャンセルしました"
  41. 10410 A$(5)="      データがありません"
  42. 10420 A$(6)="    データがいっぱいです"
  43. 10430 A$(7)="        演算を実行します"
  44. 10440 A$(8)="        演算を終了します"
  45. 10450 A$(9)="              終了します"
  46. 10460 ON ERROR GOTO *エラー処理
  47. 10470 '
  48. 10480 '
  49. 10490 ' 
  50. 10500 *入力処理 '―――――――――――――――――――――――――――――
  51. 10510 '
  52. 10520 '::: 位置決め :::
  53. 10530 MOUSE 4,0,0,639,479
  54. 10540 WHILE MOUSE(2,0)=-1 OR MOUSE(2,1)=-1
  55. 10550 WEND
  56. 10560 WHILE NOT INKEY$=""
  57. 10570 WEND
  58. 10580 WHILE MOUSE(2,0)=0
  59. 10590    IF MOUSE(2,1)=-1 THEN *終了 
  60. 10600    IN$=INKEY$ : IF NOT IN$="" THEN GOSUB *微調整
  61. 10610    IF IN$=CHR$(&H0D) THEN *演算＆出力
  62. 10620    LOCATE 0,0 : PRINT USING"Ｘ=### [dot]";MOUSE(0)
  63. 10630    LOCATE 0,1 : PRINT USING"Ｙ=### [dot]";479-MOUSE(1)
  64. 10640    IF TIME>1 THEN LOCATE 55,23 : PRINT A$(1)
  65. 10650 WEND
  66. 10660 'PCMPLAY SE01,127                                                 '**
  67. 10670 N=N+1
  68. 10680 PX(N)=MOUSE(4,0) : PY(N)=479-MOUSE(5,0)
  69. 10690 PXS(N)=PX(N) : PYS(N)=PY(N)
  70. 10700 CIRCLE(PX(N),PY(N)),3,%N,,,,F
  71. 10710 '
  72. 10720 '::: 速度決め :::
  73. 10730 LOCATE 55,23 : PRINT A$(2)
  74. 10740 WHILE MOUSE(2,0)=-1 OR MOUSE(2,1)=-1
  75. 10750 WEND
  76. 10760 WHILE NOT INKEY$=""
  77. 10770 WEND
  78. 10780 WHILE MOUSE(2,0)=0
  79. 10790    IF MOUSE(2,1)=-1 THEN *キャンセル処理
  80. 10800    IN$=INKEY$ : IF NOT IN$="" THEN GOSUB *微調整
  81. 10810    MXX=(MOUSE(0)-PX(N))/10 : MYY=(479-MOUSE(1)-PY(N))/10
  82. 10820    IF MXX=0 AND MYY=0 THEN MDD=0   : GOTO 10900
  83. 10830    IF MXX>0 AND MYY=0 THEN MDD=0   : GOTO 10900
  84. 10840    IF MXX=0 AND MYY>0 THEN MDD=90  : GOTO 10900
  85. 10850    IF MXX<0 AND MYY=0 THEN MDD=180 : GOTO 10900
  86. 10860    IF MXX=0 AND MYY<0 THEN MDD=270 : GOTO 10900
  87. 10870    MDD=ATN(MYY/MXX)*180/3.14159!
  88. 10880    IF MXX<0 THEN MDD=MDD+180 : GOTO 10900
  89. 10890    IF MXX>0 AND MYY<0 THEN MDD=MDD+360
  90. 10900    LOCATE 16,0 : PRINT USING"Ｖ=##.## [dot/cycle]";SQR(MXX^2+MYY^2)
  91. 10910    LOCATE 16,1 : PRINT USING"θ=###.# [゜]";MDD
  92. 10920    LOCATE 39,0 : PRINT USING"Ｖx=+##.# [dot/cycle]";MXX
  93. 10930    LOCATE 39,1 : PRINT USING"Ｖy=+##.# [dot/cycle]";MYY
  94. 10940 WEND
  95. 10950 'PCMPLAY SE01,127                                                 '**
  96. 10960 VX(N)=(MOUSE(4,0)-PX(N))/10 : VY(N)=(479-MOUSE(5,0)-PY(N))/10
  97. 10970 LINE(PX(N),PY(N))-STEP(VX(N)*5,VY(N)*5),PSET,4
  98. 10980 '
  99. 10990 '::: 質量決め :::
  100. 11000 MOUSE 4,0,479-PY(N),999,479-PY(N)
  101. 11010 LOCATE 55,23 : PRINT A$(3)
  102. 11020 WHILE MOUSE(2,0)=-1 OR MOUSE(2,1)=-1
  103. 11030 WEND
  104. 11040 WHILE NOT INKEY$=""
  105. 11050 WEND
  106. 11060 WHILE MOUSE(2,0)=0
  107. 11070    IF MOUSE(2,1)=-1 THEN *キャンセル処理
  108. 11080    IN$=INKEY$ : IF NOT IN$="" THEN GOSUB *微調整
  109. 11090    MMX=MOUSE(0)
  110. 11100    IF   0=<MMX AND MMX<=231 THEN PALETTE N,[ 24+MMX, 24+MMX,    255]
  111. 11110    IF 232=<MMX AND MMX<=487 THEN PALETTE N,[    255,487-MMX,487-MMX]
  112. 11120    IF 488=<MMX AND MMX<=743 THEN PALETTE N,[    255,MMX-488,      0]
  113. 11130    IF 744=<MMX AND MMX<=999 THEN PALETTE N,[999-MMX,    255,      0]
  114. 11140    MMM=(MMX+1)/2
  115. 11150    LOCATE 64,0 : PRINT USING"Ｍ=###.#";MMM
  116. 11160 WEND
  117. 11170 'PCMPLAY SE02,127                                                 '**
  118. 11180 PW(N)=MMM
  119. 11190 CLS 1
  120. 11200 IF N<10 THEN *入力処理
  121. 11210 LOCATE 55,23 : PRINT A$(6)
  122. 11220 TIME$="00:00:00"
  123. 11230 IF TIME<2 THEN 11230
  124. 11240 '
  125. 11250 '
  126. 11260 '
  127. 11270 *演算＆出力 '――――――――――――――――――――――――――――
  128. 11280 'PCMPLAY SE04,127                                                 '**
  129. 11290 CLS 1
  130. 11300 MOUSE 1,,,0
  131. 11310 LOCATE 55,23 : PRINT A$(7)
  132. 11320 TIME$="00:00:00"
  133. 11330 IF TIME<2 THEN 11330
  134. 11340 CLS 1
  135. 11350 IF N>0 THEN 11490
  136. 11360 LOCATE 55,23 : PRINT A$(5)
  137. 11370 TIME$="00:00:00"
  138. 11380 IF TIME<1 THEN 11380
  139. 11390 LOCATE 55,23 : PRINT A$(0)
  140. 11400 IF TIME<2 THEN 11400
  141. 11410 GOSUB *サンプル
  142. 11420 'PCMPLAY SE06,127                                                 '**
  143. 11430 LOCATE 78,23 : PRINT USING"#";SC
  144. 11440 READ PC,N
  145. 11450 FOR I=1 TO N
  146. 11460    READ PX(I),PY(I),VX(I),VY(I),PW(I),G,R,B
  147. 11470    PXS(I)=PX(I) : PYS(I)=PY(I) : PALETTE I,[G,R,B]
  148. 11480 NEXT I
  149. 11490 LOCATE 0,0 : PRINT"view :  0" 
  150. 11500 LOCATE 0,1 : PRINT"time :         0 [cycle]"
  151. 11510 CLS 5
  152. 11520 DEF PEN 0,5
  153. 11530 FOR I=1 TO N
  154. 11540    PSET(PX(I),PY(I)),%I
  155. 11550 NEXT I
  156. 11560 C=C+1
  157. 11570 FOR I=1 TO N
  158. 11580    FOR J=1 TO N
  159. 11590       IF MOUSE(2,1)=-1 THEN *演算終了
  160. 11600       IN$=INKEY$ : IF NOT IN$="" THEN GOSUB 11780
  161. 11610       IF J=I THEN 11670
  162. 11620       XX=PX(I)-PX(J) : YY=PY(I)-PY(J)
  163. 11630       IF XX=0 AND YY=0 THEN 11670
  164. 11640       RR=XX^2+YY^2
  165. 11650       VX(I)=VX(I)-PC*PW(J)*XX/RR^1.5!
  166. 11660       VY(I)=VY(I)-PC*PW(J)*YY/RR^1.5!
  167. 11670   NEXT J
  168. 11680   PXD(I)=PX(I)+VX(I) : PYD(I)=PY(I)+VY(I)
  169. 11690 NEXT I
  170. 11700 FOR I=1 TO N
  171. 11710    PX(I)=PXD(I) : PY(I)=PYD(I)
  172. 11720    PSET(PXS(I),PYS(I)),%11
  173. 11730    PSET(PX(I),PY(I)),%I
  174. 11740    PXS(I)=PX(I) : PYS(I)=PY(I)
  175. 11750 NEXT I
  176. 11760 LOCATE 7,1 : PRINT USING"#,###,###";C
  177. 11770 GOTO 11560
  178. 11780 IF IN$=CHR$(&H1E) THEN F=F+1 : GOTO 11830
  179. 11790 IF IN$=CHR$(&H1F) THEN F=F-1 : GOTO 11840
  180. 11800 WHILE NOT INKEY$=""
  181. 11810 WEND
  182. 11820 RETURN
  183. 11830 IF F>99 THEN F=99 : RETURN
  184. 11840 IF F<0 THEN F=0   : RETURN
  185. 11850 FX1=  0-640*F^2 : FY1=479+480*F^2
  186. 11860 FX2=639+640*F^2 : FY2=  0-480*F^2
  187. 11870 WINDOW(FX1,FY1)-(FX2,FY2)
  188. 11880 LOCATE 7,0 : PRINT USING"##";F
  189. 11890 CLS 5
  190. 11900 FOR K=1 TO N
  191. 11910    PSET(PX(K),PY(K)),%K
  192. 11920 NEXT K
  193. 11930 WHILE NOT INKEY$=""
  194. 11940 WEND
  195. 11950 RETURN
  196. 11960 '
  197. 11970 '
  198. 11980 '
  199. 11990 *微調整 '――――――――――――――――――――――――――――――
  200. 12000 IF IN$=CHR$(&H1C) THEN MOUSE 1,MOUSE(0)+1,MOUSE(1),1 : GOTO 12060
  201. 12010 IF MOUSE(0)=0 THEN GOTO 12030
  202. 12020 IF IN$=CHR$(&H1D) THEN MOUSE 1,MOUSE(0)-1,MOUSE(1),1 : GOTO 12060
  203. 12030 IF MOUSE(1)=0 THEN GOTO 12050
  204. 12040 IF IN$=CHR$(&H1E) THEN MOUSE 1,MOUSE(0),MOUSE(1)-1,1 : GOTO 12060
  205. 12050 IF IN$=CHR$(&H1F) THEN MOUSE 1,MOUSE(0),MOUSE(1)+1,1 : GOTO 12060
  206. 12060 WHILE NOT INKEY$=""
  207. 12070 WEND
  208. 12080 RETURN
  209. 12090 '
  210. 12100 '
  211. 12110 '
  212. 12120 *キャンセル処理 '――――――――――――――――――――――――――
  213. 12130 'PCMPLAY SE03,127                                                 '**
  214. 12140 N=N-1
  215. 12150 CLS
  216. 12160 LOCATE 55,23 : PRINT A$(4)
  217. 12170 TIME$="00:00:00"
  218. 12180 IF N=0 THEN *入力処理
  219. 12190 FOR I=1 TO N
  220. 12200    CIRCLE(PX(I),PY(I)),3,%I,,,,F
  221. 12210    LINE(PX(I),PY(I))-STEP(VX(I)/2,VY(I)/2),PSET,4
  222. 12220 NEXT I
  223. 12230 GOTO *入力処理
  224. 12240 '
  225. 12250 '
  226. 12260 '
  227. 12270 *エラー処理 '――――――――――――――――――――――――――――
  228. 12280 RESUME NEXT
  229. 12290 '
  230. 12300 '
  231. 12310 '
  232. 12320 *演算終了 '―――――――――――――――――――――――――――――
  233. 12330 'PCMPLAY SE05,127                                                 '**
  234. 12340 LOCATE 55,23 : PRINT A$(8)
  235. 12350 TIME$="00:00:00"
  236. 12360 IF TIME<2 THEN 12360
  237. 12370 GOTO *設定
  238. 12380 '
  239. 12390 '
  240. 12400 '
  241. 12410 *終了 '―――――――――――――――――――――――――――――――
  242. 12420 'PCMPLAY SE07,127                                                 '**
  243. 12430 ON ERROR GOTO 0
  244. 12440 MOUSE 5
  245. 12450 WINDOW(0,0)-(639,479)
  246. 12460 LOCATE 55,23 : PRINT A$(9)
  247. 12470 TIME$="00:00:00"
  248. 12480 IF TIME<2 THEN 12480
  249. 12490 CLS
  250. 12500 PALETTE
  251. 12510 CLEAR
  252. 12520 END
  253. 12530 '
  254. 12540 '
  255. 12550 '
  256. 12560 *サンプル '―――――――――――――――――――――――――――――
  257. 12570 SC=SC+1 : IF SC>5 THEN SC=0
  258. 12580 ON SC GOTO 12600,12610,12620,12630,12640
  259. 12590 RESTORE *SD0 : RETURN
  260. 12600 RESTORE *SD1 : RETURN
  261. 12610 RESTORE *SD2 : RETURN
  262. 12620 RESTORE *SD3 : RETURN
  263. 12630 RESTORE *SD4 : RETURN
  264. 12640 RESTORE *SD5 : RETURN 
  265. 12650 *SD0
  266. 12660 DATA 1,5
  267. 12670 DATA    320,240,    0.0, 0.0,   500.0,   255,255,  0
  268. 12680 DATA    100,240,    0.0, 1.5,     0.5,   150,150,255
  269. 12690 DATA    320,460,    1.5, 0.0,     0.5,   150,150,255
  270. 12700 DATA    540,240,    0.0,-1.5,     0.5,   150,150,255
  271. 12710 DATA    320, 20,   -1.5, 0.0,     0.5,   150,150,255
  272. 12720 *SD1
  273. 12730 DATA 1,4
  274. 12740 DATA    320,240,    0.0, 0.0,   500.0,     0,255,  0
  275. 12750 DATA    100,240,    0.0, 1.0,     0.5,   255,255,255
  276. 12760 DATA    240,240,    0.0, 2.0,     0.5,    24, 24,255
  277. 12770 DATA    280,240,    0.0, 3.0,     0.5,   255,255,  0
  278. 12780 *SD2
  279. 12790 DATA 1,4
  280. 12800 DATA    320,240,    0.0, 0.0,   500.0,     0,255,  0
  281. 12810 DATA    100,240,    0.0, 1.0,     0.5,   255,255,255
  282. 12820 DATA    240,240,    0.0, 2.0,     0.5,    24, 24,255
  283. 12830 DATA    280,240,    0.0,-3.0,     0.5,   255,255,  0
  284. 12840 *SD3
  285. 12850 DATA 1,5
  286. 12860 DATA    320,240,    0.0, 0.0,   500.0,     0,255,  0
  287. 12870 DATA    100,240,    0.0, 1.0,     0.5,   255,255,255
  288. 12880 DATA    240,240,    0.0, 2.0,     0.5,    24, 24,255
  289. 12890 DATA    280,240,    0.0, 3.0,     0.5,   255,255,  0
  290. 12900 DATA    500,240,    0.0, 1.0,    50.0,   120,255,  0
  291. 12910 *SD4
  292. 12920 DATA 1,5
  293. 12930 DATA    320,240,    0.0, 0.0,   500.0,     0,255,  0
  294. 12940 DATA    100,240,    0.0, 1.0,     0.5,   255,255,255
  295. 12950 DATA    240,240,    0.0, 2.0,     0.5,    24, 24,255
  296. 12960 DATA    280,240,    0.0,-3.0,     0.5,   255,255,  0
  297. 12970 DATA    500,240,    0.0, 1.0,    50.0,   120,255,  0
  298. 12980 *SD5
  299. 12990 DATA 1,5
  300. 13000 DATA    320,240,    0.0, 0.0,   500.0,     0,255,  0
  301. 13010 DATA    100,240,    0.0, 1.0,     0.5,   255,255,255
  302. 13020 DATA    240,240,    0.0, 2.0,     0.5,    24, 24,255
  303. 13030 DATA    280,240,    0.0, 3.0,     0.5,   255,255,  0
  304. 13040 DATA    500,240,    0.0,-1.0,     5.0,   120,255,  0
  305.